home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_gen / euphor14.zip / SCREEN.E < prev    next >
Text File  |  1994-09-23  |  6KB  |  217 lines
  1. -- screen.e: access to the screen
  2.  
  3.           ---------------------
  4.           -- graphics screen --
  5.           ---------------------
  6. -- in calls to read_screen and write_screen
  7. -- the screen looks like:
  8.  
  9. -- (1,1)..................(1,HSIZE)
  10. -- ................................
  11. -- ................................
  12. -- (VSIZE,1)..........(VSIZE,HSIZE)
  13.  
  14. -- "y" (second arg) is the row or line starting from the top
  15. -- "x" (first arg) is the character position starting at the left
  16. --  within the y-line. This is consistent with the TRS-80 version.
  17.  
  18. -- However, for better efficiency in Euphoria, the screen variable
  19. -- is implemented such that the first subscript selects the line
  20. -- and the second selects the character within that line. This helps
  21. -- when multiple characters are read or written on one line, since
  22. -- we can use a slice.
  23.  
  24. global constant HSIZE = 80,  -- horizontal size (char positions)
  25.         VSIZE = 21   -- vertical size (lines)
  26.  
  27.  
  28. global type h_coord(integer x)
  29. -- true if x is a horizontal screen coordinate
  30.     return x >= 1 and x <= HSIZE
  31. end type
  32.  
  33. global type v_coord(integer y)
  34. -- true if y is a vertical screen coordinate
  35.     return y >= 1 and y <= VSIZE
  36. end type
  37.  
  38. global type extended_h_coord(atom x)
  39.     -- horizontal coordinate, can be slightly off screen
  40.     return x >= -10 and x <= HSIZE + 10
  41. end type
  42.  
  43. global type extended_v_coord(atom y)
  44.     -- vertical coordinate, can be slightly off screen
  45.     return y >= -10 and y <= VSIZE + 10
  46. end type
  47.  
  48. global type screen_pos(sequence x)
  49. -- true if x is a valid screen position
  50. -- n.b. position() wants to see (x[2],x[1])
  51.     return length(x) = 2 and h_coord(x[1]) and v_coord(x[2])
  52. end type
  53.  
  54. sequence screen
  55.  
  56. integer mono_monitor
  57.  
  58. sequence vc
  59. vc = video_config()
  60. mono_monitor = not vc[VC_COLOR]
  61.  
  62. global procedure set_color(integer color)
  63.     if mono_monitor then
  64.     return
  65.     else
  66.     text_color(color)
  67.     end if
  68. end procedure
  69.  
  70. global procedure set_bk_color(integer color)
  71.     if mono_monitor then
  72.     return
  73.     else
  74.     bk_color(color)
  75.     end if
  76. end procedure
  77.  
  78.  
  79. global boolean scanon -- galaxy scan on/off
  80.  
  81. global function read_screen(object x,
  82.                 v_coord y)
  83. -- return one or more characters at logical position (x, y)
  84.     if atom(x) then
  85.     return screen[y][x]
  86.     else
  87.     return screen[y][x[1]..x[1]+x[2]-1]
  88.     end if
  89. end function
  90.  
  91. global sequence object_color 
  92. object_color =          {
  93.             YELLOW, YELLOW,
  94.             BRIGHT_BLUE, BRIGHT_BLUE,
  95.             BRIGHT_RED, BRIGHT_RED,
  96.             BRIGHT_RED, BRIGHT_RED,
  97.             BRIGHT_GREEN, BRIGHT_GREEN,
  98.             BROWN,
  99.             BROWN,
  100.             YELLOW, YELLOW,
  101.             YELLOW,
  102.             BRIGHT_MAGENTA, BRIGHT_MAGENTA
  103.             }
  104.  
  105. constant shape_list =   {
  106.             EUPHORIA_L, EUPHORIA_R,
  107.             BASIC_L, BASIC_R,
  108.             KRC_L, KRC_R,
  109.             ANC_L, ANC_R,
  110.             FORTRAN_L, FORTRAN_R,
  111.             PLANET_TOP,
  112.             PLANET_MIDDLE,
  113.             SHUTTLE_L, SHUTTLE_R,
  114.             BASE,
  115.             CPP_L, CPP_R
  116.             }
  117.  
  118. global constant BASIC_COL = find(BASIC_L, shape_list)
  119.  
  120. function which_color(object shape)
  121. -- Return color for an object based on its "shape".
  122. -- This makes it easy to add color to this old mono TRS-80 program.
  123.     integer object_number
  124.  
  125.     if atom(shape) then
  126.     if shape = '+' or shape = '-' then
  127.         return object_color[9] -- Fortran phasor
  128.     else
  129.         return WHITE
  130.     end if
  131.     end if
  132.     object_number = find(shape, shape_list)
  133.     if object_number then
  134.     return object_color[object_number]
  135.     else
  136.     return WHITE -- not found (blanks, stars)
  137.     end if
  138. end function
  139.  
  140. global procedure write_screen(h_coord x, v_coord y, object c)
  141. -- write a character or string to the screen variable
  142. -- and to the physical screen
  143.  
  144.     if atom(c) then
  145.     screen[y][x] = c
  146.     else
  147.     screen[y][x..x+length(c)-1] = c
  148.     end if
  149.     if not scanon then
  150.     set_bk_color(BLACK)
  151.     set_color(which_color(c))
  152.     position(y, x)
  153.     puts(CRT, c)
  154.     end if
  155. end procedure
  156.  
  157. global procedure display_screen(h_coord x, v_coord y, object c)
  158. -- display a character or string on the screen, but it does not affect
  159. -- the logic of the game at all (blank is actually stored)
  160.     if atom(c) then
  161.     screen[y][x] = ' '
  162.     else
  163.     screen[y][x..x + length(c) - 1] = ' '
  164.     end if
  165.     if not scanon then
  166.     position(y, x)
  167.     puts(CRT, c)
  168.     end if
  169. end procedure
  170.  
  171. global constant BLANK_LINE = repeat(' ', HSIZE)
  172.  
  173. global procedure BlankScreen(boolean var_too)
  174. -- set physical upper screen to all blanks
  175. -- and optionally blank the screen variable too
  176. -- initially the screen variable is undefined
  177.  
  178.     if not scanon then
  179.     for i = 1 to VSIZE do
  180.         position(i, 1)
  181.         puts(CRT, BLANK_LINE) -- blank upper 3/4 of screen
  182.     end for
  183.     end if
  184.     if var_too then
  185.     screen = repeat(BLANK_LINE, VSIZE) -- new blank screen
  186.     end if
  187. end procedure
  188.  
  189. global procedure ShowScreen()
  190. -- rewrite screen after galaxy scan
  191.     set_bk_color(BLACK)
  192.     set_color(WHITE)
  193.     position(1, 1)
  194.     for i = 1 to VSIZE do
  195.     position(i, 1)
  196.     puts(CRT, screen[i])
  197.     end for
  198. end procedure
  199.  
  200.        ----------------------------
  201.        -- text portion of screen --
  202.        ----------------------------
  203.  
  204. global constant QUAD_LINE = VSIZE + 1,
  205.         WARP_LINE = VSIZE + 2,
  206.         CMD_LINE  = VSIZE + 3,
  207.         MSG_LINE  = VSIZE + 4
  208.  
  209. global constant CMD_POS = 39,     -- place for first char of user command
  210.            WARP_POS = 9,      -- place for "WARP:" to appear
  211.            DREP_POS = 51,     -- place for damage report
  212.            WEAPONS_POS = 34,  -- place for torpedos/pos/deflectors display
  213.            ENERGY_POS = 67,   -- place for ENERGY display
  214.            MSG_POS = 16,      -- place for messages to start
  215.            DIRECTIONS_POS = 1 -- place to put directions
  216.  
  217.